#
# coloured petri net module for POE
# alpha version, API and features might change
#
# Copyright (c) 2002 Torvald Riegel. All rights reserved. This program is
# free software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
#


package POE::CPN;

use strict;
use POE;
use Carp;
use PetriNet::Coloured;

sub EN_WORK() { 'POECPNwork' }
sub EN_REMOTE() { 'POECPNremote' }

sub RC_ATTACH() { 'attach' }
sub RC_DETACH() { 'detach' }

sub RCPB_NET() { 'net' }
sub RCPB_WORK() { 'work' }

#
# Session constructor
#
# construct a new session, run by the net
sub newSession {
    #my ($type) = shift;
    croak "hash as param required" if @_ & 1;
    my %params = @_;
    my $alias = delete $params{alias};
    POE::Session->create
        ( inline_states =>
          { _start => sub {
                $_[KERNEL]->alias_set($alias) if defined $alias;
                #$type->newInject(%params);
                newInject(%params);
            },
            dispose => sub {
                $poe_kernel->alias_remove($alias) if defined $alias;
                dispose();
            },
            _stop => \&dispose,
          },
        );
    return undef;
}


#
# Session plugin
#
# use the current session for the net
# param hash: { netName => string, lib => PetriNet::Coloured::Library,
#               senders => { <placename> => <address> },
#               receivers => { <placename> => <event> },
sub newInject {
    #my $type = shift;
    croak "hash as param required" if @_ & 1;
    my %params = @_;
    # get heap/kernel
    croak "only call it from a running session"
      if $poe_kernel == $poe_kernel->get_active_session();
    my $heap = $poe_kernel->get_active_session()->get_heap();
    my $places = {};
    # creates senders and receivers(+ event handlers)
    foreach (keys %$params{senders}) {
        $places->{$_} = POE::CPN::Place::Send->new($params{senders}->{$_});
    }
    foreach (keys %$params{receivers}) {
        $places->{$_} = POE::CPN::Place::Receive->new();
        $poe_kernel->state($_, $places->{$_}, $params{receivers}->{$_});
    }
    # constructs the net
    my $net = PetriNet::Coloured->new($params{netname}, undef, $places);
    $params{lib}->createNet($params{netName}, existingSendersReceivers);
    # sets work event handler
    $poe_kernel->state(EN_WORK, \&work);
    # puts net on the heap
    $heap->{POECPNnet} = $net;
    #schedules inital working
    $heap->{POECPNworkScheduled} = 1;
    $poe_kernel->yield(EN_WORK);
}


#
# work loop body
#
sub work {
    my ($heap, $kernel) = @_[HEAP, KERNEL];
    if ($heap->{POECPNremote}) {
        # notify remote session
        $heap->{POECPNremote}->(RCPB_WORK);
    }
    elsif ($heap->{POECPNnet}) {
        # makes the net execute steps, if there is no net just wait
        if ($heap->{POECPNnet}->executeSteps()) {
            $kernel->yield(EN_WORK);
        } else {
            $heap->{POECPNworkScheduled} = 0;
        }
    }
}


#
# remote control
#
sub remote {
    my ($heap, $kernel, $cmd, $pb) = @_[HEAP, KERNEL, ARG0..$#_];

    if ($cmd eq RC_ATTACH) {
        # attach remote
        $heap->{POECPNremote} = $pb;
        $pb->(RCPB_NET, $net);
    } elseif ($cmd eq RC_DETACH) {
        # detach remote
        $heap->{POECPNremote} = undef;
    }
}


#
# shutdown, clears the net (breaks ref cycles)
#
sub dispose {
    my $heap = $_[HEAP];
    $heap->{POECPNremote} = undef;
    $heap->{POECPNnet}->clearNet();
    $heap->{POECPNnet} = undef;
}



##########################################################################
#
# special places to make the nets more readable
#
# implementation is kind of ugly: the real Perl object is used for the places
# while the POE session is used like another object to keep connected to
# POE::CPN stuff (current session (associated code!) and heap form an object)
# and have POE as environment.

############################
#
# registers event listener
#
package POE::CPN::Place::Receive;

use POE;
use base PetriNet::Place;
use strict;

sub new {
    my ($type) = @_;
    my $self = PetriNet::Place->new();
    $self = bless $self, $type;
    return $self;
}

sub eventHandler {
    my ($self, $heap, $kernel) = @_[OBJECT, HEAP, KERNEL];
    $self->SUPER::addToken(@_[ARG0..$#_]);
    unless ($heap->{POECPNworkScheduled}) {
        $heap->{POECPNworkScheduled} = 1;
        $kernel->yield(POE::CPN::EN_WORK);
    }
}

# this place does not consume tokens
sub isConsumer { 0 }

# TODO: addToken warning if not added due to an event ?

############################
#
# stores postback/session+event (fixed or in token)
#
package POE::CPN::Place::Send;

use POE;
use base PetriNet::Place;
use strict;

# address should either be a coderef(->postback) or a ref to a hash
# with event and session names. if the token is an arrayref its elements
# are sent as event args, otherwise the token is sent unmodified as the one arg
# if address is undef then the token to be sent must be a hash with the
# following fields:
#  postback=>\&code  OR  (event=>string AND session=>session)
#  msg => [event arguments]
sub new {
    my ($type, $address) = @_;
    my $self = PetriNet::Place->new();
    $self = bless $self, $type;
    $self->setAddress($address);
    return $self;
}

# addressMode accessors
sub setAddress {
    my ($self, $address) = @_;
    if (defined $address) {
        $address = $adress->{postback}
          if (ref($address) eq 'HASH') and exists $address->{postback};
        croak "bad address" unless (ref($address) eq 'CODE')
          or ((ref($address) eq 'HASH') and
              exists($address->{event}) and exists($address->{session}));
    }
    $self->{address} = $address;
}
sub getAddress {
    my $self = shift;
    return $self->{address};
}

# added tokens are immediately sent
sub addToken {
    my $self = shift;
    my $addr = $self->getAddress();
    if (not defined $addr) {
        # parse tokens for destination address
        foreach (@_) {
            warn "cannot parse token" unless (ref($address) eq 'HASH') and
              exists($address->{msg}) and
              (exists($address->{postback}) or
               (exists($address->{event}) and exists($adress->{session})));
            if (exists($address->{postback}) {
                $address->{postback}->(ref($address->{msg}) eq 'ARRAY' ?
                                       @{$address->{msg}} : $address->{msg});
            } else {
                $poe_kernel->post($address->{session}, $address->{event},
                                  (ref($address->{msg}) eq 'ARRAY' ?
                                   @{$address->{msg}} : $address->{msg}));
            }
        }
    }
    elsif (ref $addr eq 'CODE') {
        foreach (@_) {
            $addr->(ref $_ eq 'ARRAY' ? @$_ : $_);
        }
    }
    else {
        foreach (@_) {
            $poe_kernel->post($addr->{session}, $addr->{event},
                              (ref $_ eq 'ARRAY' ? @$_ : $_));
        }
    }
}

# this place does not produce any tokens
sub isProducer { 0 }


1;
